perm filename HIDE2[900,BGB] blob
sn#129595 filedate 1974-11-11 generic text, type T, neo UTF8
(SETQ IBASE (ADD1 7))
(DEFPROP ALL2
(NIL SETDIF
FUCK
ONCEFLATEXPR
FLATTEN
LSP
ORG
SIZ
VSUB
DIT
MIDIT
PLOT-VECTOR
FIXVEC
ARDS-VECTOR
ARDSHI
ARDSLO
DOTS
III
PLOT
ARDS
VECTOR
DATA
DETM
MMM
SPLITUP
SAFE
TEST2)
VALUE)
(DEFPROP SETDIF
(LAMBDA (A B) (COND ((NULL A) B) (T (SETDIF (CDR A) (DELETE (CAR A) B)))))
EXPR)
(DEFPROP FUCK
(LAMBDA (Z) (SET-INTERSECTION ALLFNS (ONCEFLATEXPR Z)))
EXPR)
(DEFPROP ONCEFLATEXPR
(LAMBDA (Z) (ONCEONLY (FLATTEN (GET Z (QUOTE EXPR)))))
EXPR)
(DEFPROP FLATTEN
(LAMBDA (Z) (COND ((NULL Z) NIL) ((ATOM Z) (LIST Z)) (T (APPEND (FLATTEN (CAR Z)) (FLATTEN (CDR Z))))))
EXPR)
(DEFPROP LSP
(LAMBDA(Z)
(COND ((ATOM (CAR Z))
(PROG (TEM Y TPEN)
(SETQ TEM ORG)
(SETQ Y (COND ((SETQ TPEN (ATOM (CDR Z))) (CDR Z)) (T (CADR Z))))
(SETQ ORG (CONS (PLUS (TIMES SIZ (CAR Z)) (CAR ORG)) (PLUS (TIMES SIZ Y) (CDR ORG))))
(OUTC T NIL)
(COND ((NOT (EQ PEN TPEN)) (COND ((SETQ PEN TPEN) (DIT 17 20)) (T (DIT 20 40)))))
(MIDIT (TIMES SIZ (CAR Z)) (TIMES SIZ Y))
(OUTC NIL NIL)
(RETURN ORG)))
(T (PROG2 (LSP (LIST (CAAR Z) (CDAR Z))) (LSP (CDR Z))))))
EXPR)
(DEFPROP ORG
(NIL 0 . 220)
VALUE)
(DEFPROP ORG
T
SPECIAL)
(DEFPROP SIZ
(NIL . 1)
VALUE)
(DEFPROP SIZ
T
SPECIAL)
(DEFPROP VSUB
(LAMBDA (P2 P3) (CONS (DIFFERENCE (CAR P2) (CAR P3)) (DIFFERENCE (CDR P2) (CDR P3))))
EXPR)
(DEFPROP DIT
(LAMBDA (N X) (PROG NIL L (COND ((ZEROP N) (RETURN NIL))) (TYO X) (SETQ N (SUB1 N)) (GO L)))
EXPR)
(DEFPROP MIDIT
(LAMBDA(X Y)
(COND ((ZEROP X) (DIT (ABS Y) (COND ((MINUSP Y) 10) (T 4))))
((ZEROP Y) (DIT (ABS X) (COND ((MINUSP X) 2) (T 1))))
((EQ (ABS X) (ABS Y))
(DIT (ABS X) (PLUS 100 (COND ((MINUSP X) 2) (T 1)) (COND ((MINUSP Y) 10) (T 4)))))
(T
(PROG2 (MIDIT (QUOTIENT X 2) (QUOTIENT Y 2))
(MIDIT (DIFFERENCE X (QUOTIENT X 2)) (DIFFERENCE Y (QUOTIENT Y 2)))))))
EXPR)
(DEFPROP PLOT-VECTOR
(LAMBDA(V)
(PROG NIL (LSP (LIST (CAR (VSUB (CAR V) ORG)) (CDR (VSUB (CAR V) ORG)))) (LSP (VSUB (CDR V) (CAR V)))))
EXPR)
(DEFPROP FIXVEC
(LAMBDA (V) (CONS (CONS (FIX (CAAR V)) (FIX (CDAR V))) (CONS (FIX (CADR V)) (FIX (CDDR V)))))
EXPR)
(DEFPROP ARDS-VECTOR
(LAMBDA(V)
(PROG NIL
(TYO 35)
(TYO (ARDSLO (CAAR V)))
(TYO (ARDSHI (CAAR V)))
(TYO (ARDSLO (CDAR V)))
(TYO (ARDSHI (CDAR V)))
(TYO 36)
(TYO (ARDSLO (DIFFERENCE (CADR V) (CAAR V))))
(TYO (ARDSHI (DIFFERENCE (CADR V) (CAAR V))))
(TYO (ARDSLO (DIFFERENCE (CDDR V) (CDAR V))))
(TYO (ARDSHI (DIFFERENCE (CDDR V) (CDAR V))))))
EXPR)
(DEFPROP ARDSHI
(LAMBDA (X) (BOOLE 1 137 (PLUS 100 (QUOTIENT (ABS X) 40))))
EXPR)
(DEFPROP ARDSLO
(LAMBDA (X) (BOOLE 1 177 (PLUS 100 (TIMES 2 (REMAINDER (ABS X) 40)) (COND ((MINUSP X) 1) (T 0)))))
EXPR)
(DEFPROP DOTS
(LAMBDA (Z) (COND ((NULL Z) NIL) (T (APT (FIX (CAAR Z)) (FIX (CDAR Z))) (DOTS (CDR Z)))))
EXPR)
(DEFPROP III
(LAMBDA(POLY)
(MAPC (FUNCTION
(LAMBDA(EDGE)
(MAPC (FUNCTION (LAMBDA (LINE) (PROG2 (VECTOR (FIXVEC LINE)) (SHOW 0)))) (GET EDGE VIEWNAME))))
(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES)))))
EXPR)
(DEFPROP PLOT
(LAMBDA(POLY)
(MAPC (FUNCTION
(LAMBDA (EDGE) (MAPC (FUNCTION (LAMBDA (LINE) (PLOT-VECTOR (FIXVEC LINE)))) (GET EDGE VIEWNAME))))
(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES)))))
EXPR)
(DEFPROP ARDS
(LAMBDA(POLY)
(MAPC (FUNCTION
(LAMBDA (EDGE) (MAPC (FUNCTION (LAMBDA (LINE) (ARDS-VECTOR (FIXVEC LINE)))) (GET EDGE VIEWNAME))))
(APPEND (GET POLY (QUOTE EDGEZ)) (GET POLY (QUOTE EDGES)))))
EXPR)
(DEFPROP VECTOR
(LAMBDA (V) (PROG2 (AIVECT (FIX (CAAR V)) (FIX (CDAR V))) (AVECT (FIX (CADR V)) (FIX (CDDR V)))))
EXPR)
(DEFPROP DATA
(LAMBDA NIL
(PROG NIL
(SETQ VIEWNAME (QUOTE VIEW))
(DEFPROP I1 (300 300 300) IMAGE)
(DEFPROP J1 (-300 300 300) IMAGE)
(DEFPROP K1 (-300 -300 300) IMAGE)
(DEFPROP L1 (300 -300 300) IMAGE)
(DEFPROP I2 (100 100 40) IMAGE)
(DEFPROP J2 (100 -500 40) IMAGE)
(DEFPROP K2 (-500 -500 700) IMAGE)
(DEFPROP L2 (-500 100 700) IMAGE)
(DEFPROP IJ1 (I1 . J1) POINTS)
(DEFPROP JK1 (J1 . K1) POINTS)
(DEFPROP KL1 (K1 . L1) POINTS)
(DEFPROP LI1 (L1 . I1) POINTS)
(DEFPROP IJ2 (I2 . J2) POINTS)
(DEFPROP JK2 (J2 . K2) POINTS)
(DEFPROP KL2 (K2 . L2) POINTS)
(DEFPROP LI2 (L2 . I2) POINTS)
(DEFPROP RR1 (IJ1 JK1 KL1 LI1) EDGES)
(DEFPROP RR1 (I1 J1 K1 L1) CORNERS)
(DEFPROP RR2 (IJ2 JK2 KL2 LI2) EDGES)
(DEFPROP RR2 (I2 J2 K2 L2) CORNERS)))
EXPR)
(DEFPROP DETM
(LAMBDA((CAR D) (CAR E) (CAR F) (CADR D) (CADR E) (CADR F) (CADDR D) (CADDR E) (CADDR F))
(PLUS (TIMES (CAR D) (DIFFERENCE (TIMES (CADR E) (CADDR F)) (TIMES (CADR F) (CADDR E)) 0.0))
(TIMES (MINUS (CAR E)) (DIFFERENCE (TIMES (CADR D) (CADDR F)) (TIMES (CADR F) (CADDR D))))
(TIMES (CAR F) (DIFFERENCE (TIMES (CADR D) (CADDR E)) (TIMES (CADR E) (CADDR D))))))
EXPR)
(DEFPROP MMM
(LAMBDA(X (CAAR Z) (CAADR Z) Y (CADAR Z) (CADADR Z))
(DIFFERENCE (TIMES (DIFFERENCE (CADAR Z) Y 0.0) (DIFFERENCE (CAAR Z) (CAADR Z)))
(TIMES (DIFFERENCE (CAAR Z) X 0.0) (DIFFERENCE (CADAR Z) (CADADR Z)))))
EXPR)
(DEFPROP SPLITUP
(LAMBDA NIL
(PROG (MX MY)
(SETQ MX (QUOTIENT (PLUS XLOW XHIGH) 2))
(SETQ MY (QUOTIENT (PLUS YLOW YHIGH) 2))
(WARNOCK (CONS POLYGON-LIST SURROUNDERS-LIST) MX XHIGH MY YHIGH)
(WARNOCK (CONS POLYGON-LIST SURROUNDERS-LIST) XLOW MX MY YHIGH)
(WARNOCK (CONS POLYGON-LIST SURROUNDERS-LIST) XLOW MX YLOW MY)
(WARNOCK (CONS POLYGON-LIST SURROUNDERS-LIST) MX XHIGH YLOW MY)))
EXPR)
(DEFPROP SAFE
(LAMBDA NIL (DSKOUT HIDDEN (GRINL ALLFNS)))
EXPR)
(DEFPROP TEST2
(LAMBDA NIL
(PROG NIL
(DATA)
(INITPOLY (QUOTE RR1))
(INITPOLY (QUOTE RR2))
(WARNOCK (QUOTE (RR1 RR2)) NIL -512.0 512.0 -512.0 512.0)
(SUPERSPLICE2 (QUOTE RR1))
(SUPERSPLICE2 (QUOTE RR2))
(SUPERSPLICE1 (QUOTE RR1))
(SUPERSPLICE1 (QUOTE RR2))
(LINELENGTH 77777)
(III (QUOTE RR1))
(III (QUOTE RR2))
(LINELENGTH 105)))
EXPR)